;**
;**		BRIEF -- Basic Reconfigurable Interactive Editing Facility
;**
;**		Written by Dave Nanian and Michael Strickman.
;**

;**
;**		updown.m:
;**
;**		This macro file contains routines that upper and lowercase a block.
;**	these macros are a good example of how to write a block function.  They
;**	deal with all the known special cases, including tab fields and a
;**	"percent complete" display that compensates for the size of an integer.
;**
;**		The key assignments are as follows:
;**
;**		toupper:			Uppercases a block.  Assigned to Ctrl-F6.
;**
;**		tolower:			Lowercases a block.  Assigned to Ctrl-F5.
;**
;**		Revision history:
;**		-----------------
;**		1 December 1986		Rewrote to compensate for slight problem with
;**									BRIEF v1.33 and earlier versions.  Also
;**									optimized for speed.  Thanks to Michael Hannah
;**									who pointed out the speed problems in the first
;**									place.
;**
;**		25 May 1987				Modified assigned keys because BRIEF 2.0 uses
;**									Ctrl-F5 and Ctrl-F6 for other purposes. 
;**									Started to use <Alt-9> as the equivalent of
;**									SmartKey's SuperShift.
;**									Used BRIEF 2.0's parameters for inq-marked.
;**									Added code for non-inclusive marks.
;**									Added an error message for column marks.
;**									Revised by Lew Paper

(macro updown
	(
		(assign_to_key "#-32768#108" "tolower")		; <Alt-9> Lower case L.  LP
		(assign_to_key "#-32768#117" "toupper")		; <Alt-9> u.  LP

; LP	(assign_to_key "%#98" "tolower")					;** Assigned to Ctrl-F5
; LP	(assign_to_key "%#99" "toupper")					;** Assigned to Ctrl-F6
	)
)


;**
;**		_block_case:
;**
;**		This generic function upper or lower cases a block, depending on
;**	the value of the first parameter.  Non-zero upper cases a block, zero
;**	lower cases it.
;**
;**		If no block is marked, the current line is "cased".
;**

(macro _block_case
	(
		(string	before
					after
		)
		(int	start_line
				start_col
				end_line
				end_col
				block_type						; LP
				curr_line
				curr_col							; LP
				num_lines
				do_upper
				scale_factor
				num_chars
				before_line
				before_col
				after_line
				after_col
				line
				col
				done
		)
		(message "Case converting block...")
		(get_parm 0 do_upper)
		(save_position)

		(= block_type (inq_marked start_line start_col end_line end_col))	; LP
													; Note that start always precedes end
													; and end_col for line mark is 20736,
													; while start_col is always correct

		(if (== block_type 2)				; Column mark.  LP
			(										; LP
			 	(message "Can not convert column blocks yet")	; LP
				(return 1)						; Dummy value  ; LP
			)										; LP
		)											; (if (== block_type 2) LP

		(if (! block_type)					; LP
; LP	(if (! (inq_marked))
			(
				(inq_position start_line)
				(= start_col 1)
				(end_of_line)
				(inq_position end_line end_col)
				(beginning_of_line)
			)
		;else
			(
				(raise_anchor)					; Moved here to show that we are
													; done with the original block.  LP
				(if (== block_type 4)		; Non-inclusive mark.  LP
					(								; LP
						(if (&& (== start_line end_line) (== start_col end_col))
													; Original block had only 1 character. 
													; LP
							(						; LP
								(message "nothing to do")
								(return 1)		; Throw away value
							)						; LP
						)							; (if (&& (== start_line ... LP
						(inq_position curr_line curr_col)	; LP
						(if (|| (!= curr_line start_line) (!= curr_col start_col))
													; Block marked in the upper left hand
													; corner, so skip the last character.  LP
							(						; LP
								(move_abs end_line end_col)	; LP
								(prev_char)		; LP
								(inq_position end_line end_col)
							)						; LP
						;else						; Block marked in the lower right hand
													; corner, so skip the first character.  LP
							(						; LP
								(move_abs start_line start_col)	; LP
								(next_char)		; LP
								(inq_position start_line start_col)	; LP
							)						; LP
						)							; (if (|| (!= curr_line...  LP
					)
				)									; (if (== block_type 4)  LP
				(move_abs start_line start_col)	; LP
; LP			(inq_position start_line start_col)
; LP			(swap_anchor)
; LP			(inq_position end_line end_col)

; LP			(if (|| (< end_line start_line) (&& (== start_line end_line) (< end_col start_col)))
; LP				(
; LP					(int	temp)
; LP					(= temp end_line)
; LP					(= end_line start_line)
; LP					(= start_line temp)
; LP					(= temp end_col)
; LP					(= end_col start_col)
; LP					(= start_col temp)
; LP				)
; LP			;else
; LP				(swap_anchor)
; LP				(raise_anchor)
			)										; ;else
		)	 										; (if ! block_type)
		(= num_lines (+ (- end_line start_line) 1))
		(= curr_line start_line)

		(if (> num_lines 100)
			(= scale_factor (/ 32767 num_lines))
		;else
			(= scale_factor 100)
		)
		(while (<= curr_line end_line)
			(
				(if (&& (!= curr_line end_line) (!= curr_line start_line))
					(= before (read))
				;else
					(
						(inq_position before_line before_col)
						(prev_char)
						(next_char)
						(inq_position after_line after_col)

						(if (|| (!= before_line after_line) (> after_col before_col))
							(prev_char)
						)
						(save_position)
						(end_of_line)
						(inq_position NULL after_col)
						(restore_position)

						(if (|| (!= curr_line end_line) (<= after_col end_col))
							(= before (read))
						;else
							(
								(save_position)

								(while (! done)
									(
										(++ num_chars)
										(next_char)
										(inq_position line col)
										(= done (|| (!= line end_line) (> col end_col)))
									)
								)
								(restore_position)
								(= before (read num_chars))
							)
						)
					)
				)
				(if do_upper
					(= after (upper before))
				;else
					(= after (lower before))
				)
				(if (!= after before)
					(
						(if (index after "\n")
							(
								(= after (substr after 1 (- (strlen after) 1)))
								(delete_to_eol)
							)
						;else
							(
								(drop_anchor)
								(= num_chars (strlen after))

								(while (> (-- num_chars) 0)
									(next_char)
								)
								(delete_block)
							)
						)
						(insert after)
					)
				)
				(move_abs (++ curr_line) 1)

				;**
				;**		This rather messy calculation scales things so that
				;**	we get as much granularity as possible when computing
				;**	percentages without overflowing an integer.
				;**

				(message "Case converting block, %d%% complete..."
							(/ (* 100 (/ (* (- curr_line start_line) scale_factor) num_lines)) scale_factor))
			)
		)
		(restore_position)
		(message "Case conversion completed.")
	)
)

;**
;**		toupper:
;**
;**		This simple macro calls _block_case with the parameter that means
;**	"Hey, guy, uppercase this block!"
;**

(macro toupper
	(_block_case 1)
)

;**
;**		tolower:
;**
;**		This simple macro calls _block_case with the parameter that means
;**	"Hey, guy, lowercase this block!"
;**

(macro tolower
	(_block_case 0)
)
                                 
